home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr20 / grr102.zip / GRR.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-24  |  4KB  |  148 lines
  1. PROGRAM displayGIFheader; {$i-} { see GRR.DOC for revision history }
  2. USES dos;
  3. procedure showhelp(const problem :byte);
  4. (* If any *foreseen* errors arise, we are sent here to
  5.    give a little help and exit (relatively) peacefully *)
  6. const
  7.   progdesc = 'GRR v1.02 - Free DOS utility: GIF file information displayer.';
  8.   author   = 'February 24, 1995.  Copyright (c) 1995 by David Daniel Anderson - Reign Ware.';
  9.   usage    = 'Usage:  GRR [file_spec]   Example:  GRR a:\mariah*.gif';
  10. var
  11.   message : string[50];
  12. begin
  13.   writeln(progdesc);
  14.   writeln(author);    writeln;
  15.   writeln(usage);     writeln;
  16.   if problem > 0 then begin
  17.     case problem of
  18.       1 : message := 'No files matching specification found.';
  19.     else  message := 'Unanticipated error of unknown type.';
  20.     end;
  21.     writeln (#7,message);
  22.   end;
  23.   halt(problem)
  24. end;
  25.  
  26. FUNCTION leadingzero (w :word) : STRING;
  27. VAR
  28.   s : STRING;
  29. BEGIN
  30.   str (w :0, s);
  31.   IF (length (s) = 1) THEN
  32.     s:='0'+s;
  33.   leadingzero:=s;
  34. END;
  35.  
  36. FUNCTION Comma (li :longint) : STRING;
  37. VAR s : STRING[15];
  38.     l : ShortInt;
  39. BEGIN
  40.   Str (li, s);
  41.   l:=(Length (s)-2);
  42.   WHILE (l > 1) DO BEGIN
  43.     Insert (',', s, l);
  44.     Dec (l, 3);
  45.   END;
  46.   Comma:=s;
  47. END;
  48.  
  49. Function RPad(bstr: string; Const len: byte): string;
  50. Begin
  51.   while (length(bstr) < len) do
  52.     bstr := bstr + #32;
  53.   RPad := bstr;
  54. End;
  55.  
  56. PROCEDURE getpath (VAR new_path :pathstr);
  57. BEGIN
  58.   IF (paramstr (1) = '') THEN
  59.     new_path:='*.gif'
  60.   ELSE BEGIN
  61.     new_path:=paramstr (1);
  62.     IF (pos ('.', new_path) = 0) THEN
  63.       new_path:=new_path+'*.gif';
  64.   END;
  65. END;
  66.  
  67. PROCEDURE writetime (fdatetime :longint);
  68. VAR
  69.   DateTimeInf : DateTime;
  70. BEGIN
  71.   UnpackTime (fdatetime, DateTimeInf);
  72.   WITH DateTimeInf DO BEGIN
  73.     Write
  74.       (LeadingZero (Month):4,'-', LeadingZero (Day) ,'-',
  75.                                   Copy(LeadingZero(Year),3,2), '  ',
  76.        LeadingZero (Hour)   ,':', LeadingZero (Min) ,':', LeadingZero (Sec));
  77.   END;
  78. END;
  79.  
  80. PROCEDURE checkforgiflite (VAR thefile :FILE; const offset: word);
  81. CONST
  82.    giflite: array[1..7] of char = #32#32#32#32#32#32#32;
  83.    blocklabel: array[1..2] of char = #32#32;
  84. BEGIN
  85.   seek (thefile, filepos(thefile) + 2 + (3*offset));
  86.   blockread (thefile, blocklabel, 2);
  87.   if blocklabel = #33#255 then begin
  88.     seek (thefile, filepos(thefile) + 1);
  89.     blockread (thefile, giflite, 7);
  90.   end;
  91.  
  92.   IF (giflite = 'GIFLITE')
  93.     THEN writeln ('GL')
  94.     ELSE writeln ('--');
  95. END;
  96.  
  97. TYPE
  98.   gif_header=RECORD
  99.     gif_version : ARRAY[1..6] OF char;
  100.     width,
  101.     height      : word;
  102.     resolution  : byte;  {  The next byte is "background", but I  }
  103.   END;                   {  don't want to report it at this time. }
  104.  
  105. VAR
  106.   header: gif_header;
  107.  
  108.   gpath: pathstr; gdir: dirstr; gname: namestr; gext: extstr;
  109.   dirinfo: searchrec;
  110.   giffile: file;
  111.   numfiles: word; sizefiles: longint;
  112.  
  113.   BytesRead: integer;
  114.   maxcolors: word;
  115.  
  116. BEGIN
  117.   numfiles:=0;
  118.   sizefiles:=0;
  119.   getpath (gpath);
  120.   fsplit (fexpand (gpath), gdir, gname, gext);
  121.   findfirst (gpath, hidden+archive, dirinfo);
  122.   IF (doserror <> 0) THEN showhelp(1);
  123.   WHILE (doserror = 0) DO BEGIN
  124.     assign (giffile, gdir+dirinfo.name);
  125.     reset (giffile, 1);
  126.     IF (IOResult = 0) THEN BEGIN
  127.       write ((RPad (dirinfo.name, 12)), dirinfo.size :9);
  128.       inc(numfiles,1); inc(sizefiles,dirinfo.size);
  129.       writetime (dirinfo.time);
  130.       blockread (giffile, header, sizeof (header));
  131.       IF (IOResult = 0) and (pos ('GIF' , header.gif_version) = 1) THEN
  132.         WITH header DO BEGIN
  133.           maxcolors := (2 SHL (resolution AND 7));  {formula from SWAG}
  134.           write (gif_version :10, '   [', width :4, height :5,
  135.                   (maxcolors) :5, ' ] ');
  136.           IF (resolution > 128) THEN write ('GCM/')
  137.           ELSE write ('LCM/');
  138.           checkforgiflite (giffile,maxcolors);
  139.         END
  140.       ELSE writeln('    Unrecognized format - skipping.');
  141.       close (giffile);
  142.     END;
  143.     findnext (dirinfo);
  144.   END;
  145.   writeln;
  146.   Writeln('Interrogated ',numfiles,' files totalling ',comma(sizefiles),' bytes.');
  147. END.
  148.